home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / System source / ANSI < prev    next >
Text File  |  1993-02-20  |  2KB  |  106 lines
  1. \ ANSI shell - Sept 92.
  2.  
  3. \ Loading this file should give you an ANSI Forth system.
  4.  
  5. \ We implement the CORE word set (of course), the ERROR and ERROR EXT words,
  6. \ and most of the CORE EXT words.
  7.  
  8. \ The only CORE EXT words NOT implemented are:
  9. \  C"  CONVERT  EXPECT  MARKER  ROLL  SPAN
  10. \ Of these, CONVERT, EXPECT and SPAN are obsolete, and ROLL is inefficient
  11. \ and rather useless.
  12.  
  13. need    longMath
  14.  
  15. :code 2@
  16.     move.l    (a6),a0
  17.     move.l    4(a0),(a6)
  18.     push.l    (a0)
  19. ;code
  20.  
  21. :code 2!
  22.     pop.l    a0
  23.     pop.l    (a0)+
  24.     pop.l    (a0)
  25. ;code
  26.  
  27. :code 2OVER
  28.     push.l    12(a6)
  29.     push.l    12(a6)
  30. ;code
  31.  
  32. :code 2SWAP
  33.     movem.l    (a6)+,d0-d3
  34.     push.l    d1
  35.     push.l    d0
  36.     push.l    d3
  37.     push.l    d2
  38. ;code
  39.  
  40.  
  41. : CREATE    <builds  ;
  42.  
  43. : BASE    ['] base  ;        \ BASE is a variable, not a value
  44.  
  45.  
  46. \ ENVIRONMENT is the only CORE word that takes much implementing!
  47.  
  48. string+    ENV$
  49.  
  50. : (ENV)        \ ( -- false | x true )
  51.     " /CHAR"                search: env$  if  1    true    exit  then
  52.     " /COUNTED-STRING"        search: env$  if  255    true    exit  then
  53.     " /HOLD"                search: env$  if  30    true    exit  then
  54.     " /PAD"                    search: env$  if  200    true    exit  then
  55.     " /TIB"                    search: env$  if  400    true    exit  then
  56.     " ADDRESS-UNIT-BITS"    search: env$  if  8    true    exit  then
  57.     " ALIGN"                search: env$  if  2    true    exit  then
  58.     " CORE"                    search: env$  if  true    true    exit  then
  59.     " CORE-EXT"                search: env$  if  false    true    exit  then
  60.     " FULL"                    search: env$  if  true    true    exit  then
  61.     " ERROR-HANDLING"        search: env$  if  true    true    exit  then
  62.     " ERROR-HANDLING-EXT"    search: env$  if  true    true    exit  then
  63.     " MAX-CHAR"                search: env$  if  255    true    exit  then
  64.     " MAX-D"                search: env$  if  -1  big#    true    exit  then
  65.     " MAX-N"                search: env$  if  big#    true    exit  then
  66.     " MAX-U"                search: env$  if  -1    true    exit  then
  67.     " MAX-UD"                search: env$  if  -1 -1    true    exit  then
  68.      " RETURN-STACK-CELLS"    search: env$  if  RstkSpace 4/ true    exit  then
  69.     " STACK-CELLS"            search: env$  if  StkSpace  4/ true    exit  then
  70.  
  71.     ( none matched )  false  ;
  72.  
  73.  
  74. : ENVIRONMENT    \ ( addr len -- false | x true )
  75.     put: env$  false -> case?
  76.     (env)
  77.     release: env$  ;
  78.  
  79.  
  80. \ CORE EXT words:
  81.  
  82. :code 2>R
  83.     move.l    (a6)+,-(a7)
  84.     move.l    (a6)+,-(a7)
  85. ;code
  86.  
  87. :code 2R>
  88.     move.l    (a7)+,-(a6)
  89.     move.l    (a7)+,-(a6)
  90. ;code
  91.  
  92. :code 2R@
  93.     push.l    4(a7)
  94.     push.l    (a7)
  95. ;code
  96.  
  97.  
  98. : TO    postpone ->  ;                immediate
  99.  
  100. : [COMPILE]    postpone postpone  ;    immediate
  101.  
  102. : WITHIN        over - >r - r> u<  ;
  103.  
  104. false -> slctrs?            \ Disable selectors -- in ANSI, XXX: is a
  105.                             \ normal Forth word
  106.